home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb29.arc / GRAPH2.PAS < prev    next >
Pascal/Delphi Source File  |  1985-02-25  |  19KB  |  520 lines
  1.  
  2.  
  3. procedure arbitraryscale(var inputmatrix  : matrixtype ;
  4.                              scalevector  : vectortype;
  5.                                     point : pointtype );
  6. (************************************************************
  7. **  arbitrary scale:                                       **
  8. **    scale about the given point by using translatinon    **
  9. **    and scale procedure. concatenate the result to the   **
  10. **    inputmatrix.                                         **
  11. **                                                         **
  12. **  local variables:                                       **
  13. **    i : counter                                          **
  14. **    negativepoint: negate of the input point             **
  15. **                                                         **
  16. *************************************************************)
  17.  
  18. { add a scaling to the inputmatrix about the given point}
  19.    var
  20.    i            : integer;
  21.    negativepoint : pointtype;
  22.    begin { arbitrarscale }
  23.    for i := 1 to userdimension do
  24.       negativepoint[i] := -1*point[i] ;
  25.    translate(inputmatrix,negativepoint);
  26.    scale(inputmatrix,scalevector);
  27.    translate(inputmatrix,point);
  28.    end; { arbitraryscale }
  29.  
  30.  
  31. procedure arbitraryrotate(var inputmatrix : matrixtype ;
  32.                               point       : pointtype  ;
  33.                               angle       : integer    );
  34. (************************************************************
  35. **  arbitraryrotate:                                       **
  36. **     apply a rotation about the given point by the given **
  37. **     angle( in degrees ). and concatenate the result     **
  38. **     with the input matrix. procedure is optimized       **
  39. **                                                         **
  40. **  local variables:                                       **
  41. **    rotation,tempmatrix : temporary matrices             **
  42. **    radian              : value of angle in radians      **
  43. **                                                         **
  44. *************************************************************)
  45.  
  46.    var
  47.       rotationmatrix,
  48.       tempmatrix  : matrixtype;
  49.       radian      : real;
  50.    begin  { arbitraryrotate }
  51.    radian := angle*pi/180;
  52.    rotationmatrix[1,1] := cos(radian);
  53.    rotationmatrix[1,2] := sin(radian);
  54.    rotationmatrix[1,3] := 0 ;
  55.    rotationmatrix[2,1] := -1*sin(radian) ;
  56.    rotationmatrix[2,2] := cos(radian);
  57.    rotationmatrix[2,3] := 0 ;
  58.    rotationmatrix[3,1] := point[1]*(1-cos(radian))+point[2]*sin(radian) ;
  59.    rotationmatrix[3,2] := point[2]*(1-cos(radian))-point[1]*sin(radian) ;
  60.    rotationmatrix[3,3] := 1;
  61.    concatenate(inputmatrix,rotationmatrix,tempmatrix);
  62.    inputmatrix := tempmatrix;
  63.    end;
  64.  
  65. (************************************************************
  66. **           viewing transformtion routines                **
  67. *************************************************************)
  68.  
  69.  
  70. procedure init_clip_rectangle(var viewarea : viewareatype);
  71. (************************************************************
  72. **                                                         **
  73. **  init_clip_rectangle:                                   **
  74. **    reset the viewarea with the new values of the view   **
  75. **    -port                                                **
  76. **                                                         **
  77. **  local variables:                                       **
  78. **    i : counter                                          **
  79. **                                                         **
  80. *************************************************************)
  81.  
  82.    var
  83.      i  : integer;
  84.  
  85.    begin  { init_clip_rectangle }
  86.    with viewarea[1] do
  87.       begin
  88.       a := 1;
  89.       b := 0;
  90.       c := viewminx;
  91.       orgdir := true;
  92.       end;
  93.    with viewarea[2] do
  94.       begin
  95.       a := 1;
  96.       b := 0;
  97.       c := viewmaxx;
  98.       orgdir := false;
  99.       end;
  100.    with viewarea[3] do
  101.       begin
  102.       a := 0;
  103.       b := 1;
  104.       c := viewminy;
  105.       orgdir := true;
  106.       end;
  107.    with viewarea[4] do
  108.       begin
  109.       a := 0;
  110.       b := 1;
  111.       c := viewmaxy;
  112.       orgdir := false;
  113.       end;
  114.    end; { init_clip_rectangle }
  115.  
  116. procedure updatewindow(var windowmatrix : matrixtype );
  117. (************************************************************
  118. **                                                         **
  119. ** updates the viewing transformation matrix according to  **
  120. ** the values in global variables :                        **
  121. **     xwindsize,ywindsize : window values,                **
  122. ** viewminx,viewminy,viewmaxx,                             **
  123. **                    viewmaxy : viewport coordinates      **
  124. **                                                         **
  125. **     using the formula of                                **
  126. **          xv = sx(xw - xwmin)+ xvmin                     **
  127. **          yv = sy(yw - ywmin)+ yvmin                     **
  128. **                                                         **
  129. *************************************************************)
  130.  
  131.    begin
  132.    windowmatrix[1,1] := (viewmaxx - viewminx) / (xwindsize );
  133.    windowmatrix[1,2] := 0;
  134.    windowmatrix[1,3] := 0;
  135.    windowmatrix[2,1] := 0;
  136.    windowmatrix[2,2] := (viewmaxy - viewminy) / (ywindsize );
  137.    windowmatrix[2,3] := 0;
  138.    windowmatrix[3,1] := viewminx - xwindpos * windowmatrix[1,1];
  139.    windowmatrix[3,2] := viewminy - ywindpos * windowmatrix[2,2];
  140.    windowmatrix[3,3] := 1;
  141.    end; { updatewindow }
  142.  
  143. procedure resetview ;
  144. (************************************************************
  145. **   resetview:                                            **
  146. **     reinitialize the window and viewport so the         **
  147. **     object is visible.                                  **
  148. **                                                         **
  149. *************************************************************)
  150.  
  151.    begin
  152.    viewminx := 0;
  153.    viewminy := 0;
  154.    viewmaxx := xscreensize;
  155.    viewmaxy := yscreensize;
  156.    xwindsize := 8;
  157.    ywindsize := 8;
  158.    xwindpos := -4;
  159.    ywindpos := -4;
  160.    init_clip_rectangle( myviewarea  );
  161.    updatewindow(windowmatrix);
  162.    end; { resetview }
  163.  
  164.  
  165. (************************************************************
  166. **                user menu routines                       **
  167. *************************************************************)
  168.  
  169.  
  170.  
  171. procedure gettranslate(var  transmatrix : matrixtype);
  172. (************************************************************
  173. **                                                         **
  174. **  gettranslate:                                          **
  175. **     get a translation vector from the user and do       **
  176. **     the appropriate translation                         **
  177. **                                                         **
  178. **  local variables:                                       **
  179. **     tempvector : user transformtion vector              **
  180. **                                                         **
  181. *************************************************************)
  182.  
  183.    var
  184.       transvector : vectortype;
  185.    begin
  186.    writeln;
  187.    writeln( '**  give me the translation values ** ');
  188.    writeln;
  189.    readvector(transvector);
  190.    translate(transmatrix , transvector );
  191.    print(transmatrix);
  192.    end; { gettranslate }
  193.  
  194. procedure getscale( var transmatrix : matrixtype);
  195. (************************************************************
  196. **                                                         **
  197. **  getscale:                                              **
  198. **      get a scaling vector and a point about which to    **
  199. **      scale . and do the scaling                         **
  200. **                                                         **
  201. **  local variables:                                       **
  202. **      point : point about which to scale                 **
  203. **      scalevect : user scaling vector                    **
  204. **                                                         **
  205. *************************************************************)
  206.  
  207.    var
  208.       point : pointtype;
  209.       scalevect : vectortype;
  210.    begin
  211.    writeln;
  212.    writeln('****** scale about a point ******');
  213.    writeln('** first give me the point about which to scale **  ');
  214.    writeln;
  215.    readvector(point);
  216.    writeln;
  217.    writeln('** now give me the scaling vector ** ');
  218.    writeln;
  219.    readvector(scalevect);
  220.    arbitraryscale(transmatrix , scalevect , point) ;
  221.    print(transmatrix);
  222.    end; { getscale }
  223.  
  224. procedure getrotate( var transmatrix : matrixtype);
  225. (************************************************************
  226. **   getrotate:                                            **
  227. **     get a point and angle of rotation from the user     **
  228. **     and go do the actual rotation. add it to the        **
  229. **     transformatiion matrix                              **
  230. **                                                         **
  231. **  local variables:                                       **
  232. **     point : user rotation point                         **
  233. **     angle : angle of rotation                           **
  234. **                                                         **
  235. *************************************************************)
  236.    var
  237.       point : pointtype;
  238.       angle : integer;
  239.    begin
  240.    writeln;
  241.    writeln('*****   rotate about a point    *******');
  242.    writeln('**  first give me the rotation value **');
  243.    write('** in degrees counterclockwise? ');
  244.    readln( angle);
  245.    writeln;
  246.    writeln('** now give me the point to rotate about **');
  247.    readvector(point);
  248.    arbitraryrotate(transmatrix ,  point , angle);
  249.    print(transmatrix);
  250.    end; { getrotate }
  251.  
  252. procedure changeviewport;
  253. (************************************************************
  254. **  changeviewport:                                        **
  255. **     get the new values of the viewport from the user    **
  256. **     and reset the wiewing matrix and viewarea to        **
  257. **     reflect the change.                                 **
  258. **                                                         **
  259. **  local variables:                                       **
  260. **     temp : temporary normalize form of viewport location**
  261. **                                                         **
  262. *************************************************************)
  263.  
  264.    var
  265.     temp : real;
  266.    begin
  267.    writeln;
  268.    writeln('********      change viewport    **********');
  269.    writeln;
  270.    writeln('** enter the coordinates of the viewport **');
  271.    writeln('**    in normalized form (real 0..1 )    **');
  272.    repeat
  273.       write('** minimum x-axis? ');
  274.       readln(temp);
  275.       viewminx := trunc( temp * xscreensize );
  276.       write('** maximum x-axis? ');
  277.       readln(temp);
  278.       viewmaxx := trunc(temp * xscreensize );
  279.       write('** minimum y-axis? ');
  280.       readln(temp);
  281.       viewminy := trunc( temp * yscreensize );
  282.       write('** maximum y-axis? ');
  283.       readln(temp);
  284.       viewmaxy := trunc( temp * yscreensize );
  285.    until ((viewminx < viewmaxx) and (viewminy < viewmaxy));
  286.    updatewindow(windowmatrix);
  287.    init_clip_rectangle(myviewarea );
  288.    print(windowmatrix);
  289.    end;
  290.  
  291. procedure changewindow;
  292. (************************************************************
  293. **  changewindow:                                          **
  294. **      get the new window size from the user and update   **
  295. **      the wiewing matrix                                 **
  296. **                                                         **
  297. *************************************************************)
  298.  
  299.    begin
  300.    writeln;
  301.    writeln('********  change window size  ********');
  302.    writeln;
  303.    writeln('** enter the size of the window     ** ');
  304.    writeln('** in integer form ,can not be zero **');
  305.    repeat
  306.       write('** size in x direction? ');
  307.       readln(xwindsize);
  308.       until xwindsize <> 0;
  309.    repeat
  310.       write('** size in y direction? ');
  311.       readln(ywindsize);
  312.       until ywindsize <> 0;
  313.    init_clip_rectangle(myviewarea );
  314.    updatewindow( windowmatrix);
  315.    print(windowmatrix);
  316.    end; { changewindow }
  317.  
  318. procedure movewindow;
  319. (************************************************************
  320. **  movewindow:                                            **
  321. **    get the new location of the window and update the    **
  322. **    viewing matrix                                       **
  323. **                                                         **
  324. *************************************************************)
  325.  
  326.    begin
  327.    writeln;
  328.    writeln('*********    move the window    **********');
  329.    writeln;
  330.    writeln('** enter the new location of the window **');
  331.    writeln('** this is the location of the lower    ** ');
  332.    writeln('** lefthand corner  of the window       ** ');
  333.    writeln;
  334.    write('** x coordinate ? ');
  335.    readln(xwindpos);
  336.    write('** y coordinate ? ');
  337.    readln(ywindpos);
  338.    updatewindow(windowmatrix);
  339.    print(windowmatrix);
  340.    end; { movewindow }
  341.  
  342.  
  343.  
  344. procedure drawline( segment : segmenttype;
  345.                     matrix  : matrixtype   );
  346. (************************************************************
  347. **  drawline:                                              **
  348. **     draw the line segment after applying the given      **
  349. **     matrix to it. and clipping it to the viewport.      **
  350. **     used by the draw window procedure                   **
  351. **                                                         **
  352. **  local variables:                                       **
  353. **     outside : whether the line is totally outside or not**
  354. **                                                         **
  355. *************************************************************)
  356.  
  357.    var
  358.      outside : boolean;
  359.    begin
  360.    applymatrix(segment,matrix);
  361.    clip_line(segment,segment,myviewarea,outside);
  362.    if not outside then
  363.       begin
  364.       line(trunc(segment[1,1]),trunc(segment[1,2]),
  365.            trunc(segment[2,1]),trunc(segment[2,2]));
  366.       end;
  367.    end; { drawline }
  368.  
  369. procedure drawsymbol(symbol : command) ;
  370. (************************************************************
  371. **  drawsymbol:                                            **
  372. **    draw the symbol which is a list of commands.         **
  373. **    each command could be a line or polygon              **
  374. **                                                         **
  375. **  local variables:                                       **
  376. **    tempmatrix : result of concatenation of trans and    **
  377. **                 view matrices                           **
  378. **    tempcommand : local pointer to the symbol commands   **
  379. **     polyptr    : pointers to the polygon nodes          **
  380. **     tempsegment: temporary line segment                 **
  381. **                                                         **
  382. *************************************************************)
  383.    var
  384.       tempmatrix : matrixtype;
  385.       tempcommand: command;
  386.       polyptr1,
  387.       polyptr2   : polygontyp;
  388.       tempsegment: segmenttype;
  389.    begin
  390.  
  391.    hires;
  392.    hirescolor(white);
  393.  
  394.    line(viewminx,viewminy,viewmaxx,viewminy);
  395.    line(viewminx,viewmaxy,viewmaxx,viewmaxy);
  396.    line(viewminx,viewminy,viewminx,viewmaxy);
  397.    line(viewmaxx,viewminy,viewmaxx,viewmaxy);
  398.  
  399.    concatenate(transmatrix,windowmatrix,tempmatrix);
  400.    tempcommand := symbol;
  401.    while ( tempcommand <> nil ) do
  402.       begin
  403.       with tempcommand^ do
  404.          begin
  405.          case kind of
  406.             lineseg : begin
  407.                       drawline(segment , tempmatrix );
  408.                       end;
  409.             poly    : begin
  410.                       polyptr1 := polygon;
  411.                       polyptr2 := polygon^.next;
  412.                       repeat
  413.                          tempsegment[1] := polyptr1^.point;
  414.                          tempsegment[2] := polyptr2^.point;
  415.                          drawline(tempsegment , tempmatrix);
  416.                          polyptr1 := polyptr2;
  417.                          polyptr2 := polyptr2^.next;
  418.                       until (polyptr1 = polygon );
  419.                       end;
  420.             end; { case }
  421.          tempcommand := tempcommand^.next;
  422.          end; { with }
  423.       end; { while }
  424.  
  425.    gotoxy(24,1);
  426.    writeln('press a key to continue');
  427.    while not keypressed do;
  428.    textmode(bw80);
  429.    textcolor(white);
  430.    end; { draw }
  431.  
  432.  
  433.  
  434.  
  435. procedure menu;
  436. (************************************************************
  437. **   menu:                                                 **
  438. **     give the user a menu to work with.                  **
  439. **     has toggle print and expert mode options            **
  440. **                                                         **
  441. *************************************************************)
  442.  
  443.    var
  444.      i : integer;
  445.      expert : boolean;
  446.      done   : boolean;
  447.      c      : char;
  448.    begin
  449.    expert := false;
  450.    done   := false;
  451.    repeat
  452.    if not expert then
  453.       begin
  454.       writeln('********  user menu options ********* ');
  455.       writeln('** 0. quit this program ');
  456.       writeln('** 1. translate the model');
  457.       writeln('** 2. scale the model about a point ');
  458.       writeln('** 3. rotate the model about a point ');
  459.       writeln('** 4. reset the transformation matrix');
  460.       writeln('** 5. reset the viewing and viewport ');
  461.       writeln('** 6. change the viewport');
  462.       writeln('** 7. change the window size');
  463.       writeln('** 8. change window location');
  464.       writeln('** 9. clear the screen ');
  465.       writeln('**10. draw the model ');
  466.       writeln('**11. set expert mode ');
  467.       writeln('**12. toggle print mode ');
  468.       end
  469.    else
  470.    begin
  471.    writeln(' 0. quit      1. trans      2. scal      3. rotat   4. rst-trans');
  472.    writeln(' 5. rst-view  6. chg-view   7. wnd-size  8. wnd-loc 9. clr');
  473.    writeln('10. draw     11.novice     12. togl-prnt  ');
  474.    end;
  475.    repeat
  476.      write('** your choice (0 to 12)? ');
  477.      readln(i);
  478.      until ((i>=0) and ( i<=12));
  479.    case i of
  480.       0 : begin
  481.           write('are you sure (y/n) ? ');
  482.           readln(c);
  483.           if c in ['y','Y'] then
  484.              done := true;
  485.           end;
  486.       1 : gettranslate(transmatrix) ;
  487.       2 : getscale(transmatrix)     ;
  488.       3 : getrotate(transmatrix)    ;
  489.       4 : setidentity(transmatrix);
  490.       5 : resetview;
  491.       6 : changeviewport;
  492.       7 : changewindow;
  493.       8 : movewindow;
  494.       9 : {clearscreen} ;
  495.       10: drawsymbol(mysymbol) ;
  496.       11: expert := not expert ;
  497.       12: printmode := not printmode ;
  498.       end; { case }
  499.    until done ;
  500.    end; { menu }
  501.  
  502.  
  503.  
  504. (************************************************************
  505. **                  main program                           **
  506. *************************************************************)
  507.  
  508. begin  { main }
  509. xscreensize := 639;
  510. yscreensize := 199;
  511. printmode := false;
  512. initialize;
  513. resetview;
  514. define_model(mysymbol);
  515. setidentity(transmatrix);
  516. menu;
  517. end.   { main }
  518. 9;
  519. printmode := false;
  520. initializ